home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TUT13.ZIP / TUTPRO13.PAS < prev   
Pascal/Delphi Source File  |  1994-07-23  |  6KB  |  173 lines
  1. {$X+}
  2. USES GFX2,crt;
  3.  
  4. CONST Num = 400;     { Number of stars }
  5.  
  6. TYPE Star = Record
  7.               x,y,z:integer;
  8.             End;     { Information on each star }
  9.      Pos = Record
  10.              x,y:integer;
  11.            End;      { Information on each point to be plotted }
  12.  
  13. VAR Stars : Array [1..num] of star;
  14.     Clear : Array [1..2,1..num] of pos;
  15.  
  16. {──────────────────────────────────────────────────────────────────────────}
  17. Procedure Init;
  18. VAR loop1,loop2:integer;
  19.     logo:array [1..50,1..320] of byte;
  20. BEGIN
  21.   for loop1:=1 to num do
  22.     Repeat
  23.       stars[loop1].x:=random (320)-160;
  24.       stars[loop1].y:=random (200)-100;
  25.       stars[loop1].z:=loop1;
  26.     Until (stars[loop1].x<>0) and (stars[loop1].y<>0);
  27.       { Make sure no stars are heading directly towards the viewer }
  28.   pal (32,00,00,30);
  29.   pal (33,10,10,40);
  30.   pal (34,20,20,50);
  31.   pal (35,30,30,60);   { Pallette for the stars coming towards you }
  32.  
  33.   pal (247,20,20,20);
  34.   pal (136,30,0 ,0 );
  35.   pal (101,40,0 ,0 );
  36.   pal (19 ,60,0 ,0 );  { Pallette for the logo at the top of the screen }
  37.  
  38.   loadcel ('logo.cel',addr(logo));
  39.   for loop1:=0 to 319 do
  40.     for loop2:=1 to 50 do
  41.       putpixel (loop1,loop2-1,logo[loop2,loop1+1],vga);
  42.     { Placing the logo at the top of the screen }
  43. END;
  44.  
  45. {──────────────────────────────────────────────────────────────────────────}
  46. Procedure Calcstars;
  47.   { This ccalculates the 2-d coordinates of our stars and saves these values
  48.     into the variable clear }
  49. VAR loop1,x,y:integer;
  50. BEGIN
  51.   For loop1:=1 to num do BEGIN
  52.     x:=((stars[loop1].x shl 7) div stars[loop1].z)+160;
  53.     y:=((stars[loop1].y shl 7) div stars[loop1].z)+100;
  54.     clear[1,loop1].x:=x;
  55.     clear[1,loop1].y:=y;
  56.   END;
  57. END;
  58.  
  59. {──────────────────────────────────────────────────────────────────────────}
  60. Procedure Drawstars;
  61.   { This draws the 2-d values stored in clear to the vga screen, with various
  62.     colors according to how far away it is. }
  63. VAR loop1,x,y:integer;
  64. BEGIN
  65.   For loop1:=1 to num do BEGIN
  66.     x:=clear[1,loop1].x;
  67.     y:=clear[1,loop1].y;
  68.     if (x>0) and (x<320) and (y>50) and (y<200) then
  69.       If stars[loop1].z>400 then putpixel(x,y,32,vga)
  70.       else
  71.       If stars[loop1].z>300 then putpixel(x,y,33,vga)
  72.       else
  73.       If stars[loop1].z>200 then putpixel(x,y,34,vga)
  74.       else
  75.       If stars[loop1].z>100 then putpixel(x,y,34,vga)
  76.       else
  77.       putpixel(x,y,35,vga)
  78.   END;
  79. END;
  80.  
  81. {──────────────────────────────────────────────────────────────────────────}
  82. Procedure Clearstars;
  83.   { This clears the 2-d values from the vga screen, which is faster then a
  84.     cls (vga,0) }
  85. VAR loop1,x,y:integer;
  86. BEGIN
  87.   For loop1:=1 to num do BEGIN
  88.     x:=clear[2,loop1].x;
  89.     y:=clear[2,loop1].y;
  90.     if (x>0) and (x<320) and (y>50) and (y<200) then
  91.       putpixel (x,y,0,vga);
  92.   END;
  93. END;
  94.  
  95.  
  96. {──────────────────────────────────────────────────────────────────────────}
  97. Procedure MoveStars (Towards:boolean);
  98.   { If towards is True, then the z-value of each star is decreased to come
  99.     towards the viewer, otherwise the z-value is increased to go away from
  100.     the viewer }
  101. VAR loop1:integer;
  102. BEGIN
  103.   If towards then
  104.     for loop1:=1 to num do BEGIN
  105.       stars[loop1].z:=stars[loop1].z-2;
  106.       if stars[loop1].z<1 then stars[loop1].z:=stars[loop1].z+num;
  107.     END
  108.     else
  109.     for loop1:=1 to num do BEGIN
  110.       stars[loop1].z:=stars[loop1].z+2;
  111.       if stars[loop1].z>num then stars[loop1].z:=stars[loop1].z-num;
  112.     END;
  113. END;
  114.  
  115. {──────────────────────────────────────────────────────────────────────────}
  116. Procedure Play;
  117.   { This is our main procedure }
  118. VAR ch:char;
  119. BEGIN
  120.   Calcstars;
  121.   Drawstars;  { This draws our stars for the first time }
  122.   ch:=#0;
  123.   Repeat
  124.     if keypressed then ch:=readkey;
  125.     clear[2]:=clear[1];
  126.     Calcstars;     { Calculate new star positions }
  127.     waitretrace;
  128.     Clearstars;    { Erase old stars }
  129.     Drawstars;     { Draw new stars }
  130.     if ch=' ' then Movestars(False) else Movestars(True);
  131.       { Move stars towards or away from the viewer }
  132.   Until ch=#27;
  133.     { Until the escape key is pressed }
  134. END;
  135.  
  136. BEGIN
  137.   clrscr;
  138.   writeln ('Hello! Another effect for you, this one is on starfields, again by');
  139.   writeln ('request.  In this sample program, a starfield will be coming towards');
  140.   writeln ('you. Hit the space bar to have it move away from you, any other key');
  141.   writeln ('to have it come towards you again. Hit [ESC] to end.');
  142.   writeln;
  143.   Writeln ('The logo at the top of the screen was drawn by me in Autodesk Animator.');
  144.   Writeln ('It only took a few seconds, so please don''t laugh too much at my attempt.');
  145.   writeln;
  146.   writeln ('The code is very easy to follow, and the documentation is as usual in the');
  147.   writeln ('main text. Leave me mail with further ideas for future trainers.');
  148.   writeln;
  149.   writeln;
  150.   write ('Hit any key to continue ...');
  151.   readkey;
  152.   randomize;
  153.   setmcga;
  154.   init;
  155.   Play;
  156.   settext;
  157.   Writeln ('All done. This concludes the thirteenth sample program in the ASPHYXIA');
  158.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  159.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  160.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  161.   Writeln ('    smith9@batis.bis.und.ac.za');
  162.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  163.   Writeln ('             Grant Smith');
  164.   Writeln ('             P.O. Box 270');
  165.   Writeln ('             Kloof');
  166.   Writeln ('             3640');
  167.   Writeln ('             Natal');
  168.   Writeln ('             South Africa');
  169.   Writeln ('I hope to hear from you soon!');
  170.   Writeln; Writeln;
  171.   Write   ('Hit any key to exit ...');
  172.   readkey;
  173. END.